home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Module source / QPmod.txt < prev    next >
Text File  |  1993-02-01  |  1KB  |  51 lines
  1. \ qprint - quick printer for Mops source files
  2. \  July 90    mrh    Mops version.
  3.  
  4. // dateTime
  5.  
  6.     9    constant    TAB
  7.     8    constant    TABWIDTH
  8.  
  9.     string+        LINBUF
  10.  
  11.  
  12. : .FOOTER
  13.     pcr pcr  5  spaces 
  14.     ." Mops source file:  "   getName: topFile  ptype
  15.     3 spaces  topfile 76 + @  put: sysdate ." Rev:  " print: sysDate
  16.     7 spaces ." Page "  . pcr np  ;
  17.  
  18. : PrintCRs    FOR  pcr  NEXT  ;
  19.  
  20.  
  21. : QPRINT  { \ theLine thePage ubase #bl #lines -- }    \ Exported.
  22.     pushNew: loadfile  'type TEXT 1  stdGet: topFile
  23.     NIF  drop: loadfile  EXIT  THEN
  24.     new: linBuf
  25.     base -> ubase decimal
  26.     ['] drop -> emitVec   ['] 2drop -> typeVec
  27.     #lines/page 8 -  -> #lines
  28.     0 -> theLine 1 -> thePage  +print
  29.     openReadOnly: topFile  ?error 132  getfileinfo: topfile  drop
  30.     BEGIN
  31.         topFile 255  readLine?: linBuf
  32.     WHILE
  33.         start: linBuf        \ expand tabs
  34.         BEGIN
  35.             nolim: linBuf  tab chsearch: linBuf
  36.         WHILE
  37.             tabWidth  lim: linBuf tabWidth mod  -  -> #bl
  38.             lim: linBuf  >pos: linBuf  1 more: linBuf
  39.             "             " drop  #bl  repl: linBuf
  40.         REPEAT
  41.         theLine 5 .r 3 spaces
  42.         all: linBuf  90 min  ptype pcr  1 ++> theLine
  43.         theLine #lines  mod
  44.         NIF thePage .footer 1 ++> thePage THEN
  45.     REPEAT
  46.     #lines  theLine #lines mod -  printCRs
  47.     thePage .footer
  48.     -print  0 -> emitvec  0 -> typevec
  49.     release: linBuf  drop: loadfile
  50.     ubase -> base  ;
  51.